'BuildModuleList: Build Module List by walking the MODULEENTRY struct list
CRLF$ = Chr$(13) & Chr$(10)
Dim mo As MODULEENTRY
mo.dwSize = Len(mo)
screen.MousePointer = 11
yield% = DoEvents()
If ModuleFirst(mo) = 0 Then
MsgBox "Could not retrieve the first module in the module list. This is probably due to a corrupted system or an incompatible Windows version.", 16, "Fatal Error"
DoEnd
End If
'Extract the first Icon from the module file into our Picture1 control
'BuildTaskList: Build Task List using a GetWindow() loop (TASKMAN style)
Dim te As TASKENTRY
screen.MousePointer = 11
yield% = DoEvents()
'Get the first window known to Windows. The Me.hWnd is just
' here because we need to pass a *valid* hWnd
hWndTest% = GetWindow(Me.hWnd, GW_HWNDFIRST)
'As long as the hWnd we got is valid ...
While hWndTest%
'Test to see if the associated window has a owner. If
' it has, it's not a top-level window and we don't
' bother with it
If GetWindow(hWndTest%, GW_OWNER) = 0 Then
'Otherwise, get the window caption (text)
buf$ = Space$(256)
res% = GetWindowText(hWndTest%, buf$, 256)
If res% > 1 Then
'And if that went well add it to our list ...
GetTaskEntry GetWindowTask(hWndTest%), te
AddTaskEntryToList te, hWndTest%
End If
End If
'Get the handle of the next window, if any
hWndTest% = GetWindow(hWndTest%, GW_HWNDNEXT)
screen.MousePointer = 0
End Sub
Static Sub BuildTaskList2 ()
'BuildTaskList2: Build Task List by walking the TASKENTRY struct list
screen.MousePointer = 11
yield% = DoEvents()
Dim te As TASKENTRY
te.dwSize = Len(te)
If TaskFirst(te) = 0 Then
'Sanity check
MsgBox "Could not retrieve the first task in the task list. This is probably due to a corrupted system or an incompatible Windows version.", 16, "Fatal Error"
End
End If
'Simply walk get all TASKENTRY structs and process 'em
AddTaskEntryToList te, 0
Loop While TaskNext(te)
screen.MousePointer = 0
End Sub
Sub CascadeWindows_Click ()
'CascadeWindows: Cascade all Windows on the Desktop
'This code is based on information and sample source code
'from UNDOCUMENTED WINDOWS
'Check SHIFT key state. If the user depresses it while
' clicking the Cascade button, do a horizontal cascade
' (stacked windows). Do a vertical cascase (windows side
' by side) otherwise. This also works with the normal
'ClassInfo: display all window classes associated with the
' current task
screen.MousePointer = 11
CRLF$ = Chr$(13) & Chr$(10)
'Init description and list
ClassList!DescLabel.Caption = "Window Class Information for " & Left$(List1.Text, InStr(List1.Text, Chr$(13)) - 1)
ClassList!List2.DrawFlags(1) = &H110
'Which hModule are we looking for?
hModuleTest% = GetCurrentModuleFromList%()
Dim ce As CLASSENTRY, wc As WNDCLASS
ce.dwSize = Len(ce)
'Get first class from TOOLHELP class list
If ClassFirst(ce) = 0 Then
'Sanity check failed
MsgBox "Could not retrieve the first class in the class list. This is probably due to a corrupted system or an incompatible Windows version.", 16, "Fatal Error"
DoEnd
End If
'If the window class' hInst matches the hModule we're looking for ...
'GetTaskEntry: Get TASKENTRY structure for a given hTask
te.dwSize = Len(te)
If TaskFirst(te) = 0 Then
MsgBox "Could not retrieve the first task in the task list. This is probably due to a corrupted system or an incompatible Windows version.", 16, "Fatal Error"
DoEnd
End If
If te.hTask = hTask% Then Exit Sub
Loop While TaskNext(te)
MsgBox "TASKENTRY for hTask not found", 16, "Fatal Internal Error"
End Sub
Sub List1_Click ()
If List1.ListIndex > -1 Then
ClassInfo.Enabled = True
If Not UseModules.Value Then SwitchTo.Enabled = True
If Not UseModules.Value Then CloseTask.Enabled = True
NukeTask.Enabled = True
End If
End Sub
Sub Msg1_Message (MsgVal As Integer, wParam As Integer, lParam As Long, ReturnVal As Long)
'Msg1_Message: handle Windows messages
'Adapted from code in SMALLCAP (see TASKLIST.WRI for details)
'Flag to keep 'floating' status
Static MenuFlag%
'Check the message we just got
Select Case MsgVal
'Did we get (de)activated?
Case WM_NCACTIVATE
If wParam% Then
'Draw 'active' caption
mCaptionColor& = GetSysColor(COLOR_ACTIVECAPTION) And &HFFFFFF
Else
'Draw 'inactive' caption
mCaptionColor& = GetSysColor(COLOR_INACTIVECAPTION) And &HFFFFFF
End If
Me.Refresh
'Was the mouse moved over our form?
Case WM_NCHITTEST
mxPos% = (lParam And &HFFFF&)
myPos% = (lParam / 65536)
mFormTop% = Top / screen.TwipsPerPixelY
mFormLeft% = Left / screen.TwipsPerPixelX
'Is it now over the caption bar?
If (myPos% - mFormTop% < 20) And (mxPos% - mFormLeft% > 17) Then
ReturnVal = HTCAPTION
mInSysMenu% = False
'Is it within the System Menu box?
ElseIf (myPos% - mFormTop% < 20) And (mxPos% - mFormLeft% < 20) Then
ReturnVal = HTSYSMENU
'Otherwise it's in the client area ...
Else
ReturnVal = HTCLIENT
mInSysMenu% = False
End If
'Was there a dubble click with the left mouse button?
Case WM_NCLBUTTONDBLCLK
'If the cursor was within the system menu box, exit
If wParam% = HTSYSMENU Then
DoEnd
End If
'Was the left mouse button pressed?
Case WM_NCLBUTTONDOWN
'If the cursor was in the system menu box ...
If wParam% = HTSYSMENU Then
'Check if we're currently showing the system menu
If mInSysMenu% Then
'And if yes, do nothing and reset flag
'(menu will 'disappear' later because of the click)
res% = ModifyMenu(mhSysMenu%, 3, MF_ENABLED Or MF_STRING Or MF_BYPOSITION, IDM_FLOAT, "&Always on Top")
Else
'Make our window topmost
res% = SetWindowPos(Me.hWnd, -1, 0, 0, 0, 0, 3)
'And check the menu option
res% = ModifyMenu(mhSysMenu%, 3, MF_ENABLED Or MF_STRING Or MF_CHECKED Or MF_BYPOSITION, IDM_FLOAT, "&Always on Top")
End If
End Select
'Did another Window get created/destroyed (so we should refresh)?
Case WM_OTHERWINDOWCREATED, WM_OTHERWINDOWDESTROYED
MsgBox "WM_OTHERWINDOWxxx received", 64, "Test"
Call RefreshList_Click
End Select
End Sub
Sub NukeTask_Click ()
'This button does something completely different depending
'on the kind of list displayed:
If Not UseModules.Value Then
'Task list: close app
If MsgBox("Closing this app the hard way might reduce your once-working Windows system to a huge GPF-feast. Continue anyway?", 36, "Government Health Warning") = 6 Then
TerminateApp GetCurrentTaskFromList%(), 1
End If
'Module list: unload module
If List1.ListIndex < 7 Then
tmp$ = "Unloading a Windows Kernel module will CRASH the system"
Else
tmp$ = "Unloading a module may crash the system"
End If
If MsgBox(tmp$ & ". Continue anyway?", 36, "Government Health Warning") = 6 Then
For a% = 1 To GetCurrentUsageFromList%()
FreeModule List1.ItemData(List1.ListIndex)
Next a%
End If
End If
yield% = DoEvents()
Call RefreshList_Click
End Sub
Sub RefreshList_Click ()
'RefreshList_Click: Decide what kind of list to display,
' update buttons accordingly and call list function
List1.Clear
ClassInfo.Enabled = False
SwitchTo.Enabled = False
CloseTask.Enabled = False
NukeTask.Enabled = False
If UseWins.Value Or UseTasks.Value Then
NukeTask.Caption = "&Nuke task"
Call BuildTaskList
ElseIf UseModules.Value Then
NukeTask.Caption = "&Unload module"
Call BuildModuleList
MsgBox "I'm confused!", 64, "Nothing to refresh"
End If
End Sub
Sub RunProgram_Click ()
'RunProgram_Click: ask user for a program to run and do it
On Local Error Resume Next
resp$ = InputBox$("Enter command line", "Run")
If Len(resp$) Then
Err = 0
pid% = Shell(resp$)
If Err Then
MsgBox Error$(Err), 48, "Cannot execute"
Else
yield% = DoEvents()
Call RefreshList_Click
End If
End If
End Sub
Sub ShowSysMenu ()
'ShowSysMenu: Drop down our own 'system menu'
'Adapted from code in SMALLCAP (see TASKLIST.WRI)
InPixels% = Me.ScaleWidth
Me.ScaleMode = 1
'Determine if we should show the menu below or above our window
(.txt)